home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / datebox.exe / DATETEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-07-07  |  5.5 KB  |  189 lines
  1. program testdate;
  2. uses     datebox,crt,dos,keybrd;
  3. { KEYBRD is my I/O-unit; just remove it's reference and the brackets
  4. surrounding keytype, keysettype and key in DATEBOX.PAS and everthing
  5. will work standalone}
  6. var     buf:string;
  7.         long_i:longint;
  8.         buf_dt,buf_dt1:datetime;
  9.         language_set,i,j:integer;
  10.           ch:char;
  11. (********************************)
  12. procedure test_datetext;
  13.  
  14. procedure test_text(long_dt:longint);
  15. var buf_dt:datetime;
  16.  
  17. procedure write_text(x:integer);
  18. begin
  19.       dt_from_longdat(long_dt,buf_dt);
  20.         writeln(8+x:5,'   ',datetext(buf_dt,8+x):28,'      ',
  21.                                         10+x:5,'   ',datetext(buf_dt,10+x):28);
  22. end;
  23. begin
  24.     case language of
  25.     0:write('English ');
  26.     1:write('Deutsch ');
  27.     2:write('Français');
  28.     3:write('Italiano');
  29.     end;
  30.      writeln;
  31.     writeln('Value:','8-digit values':30,'Value:':11,'10-digit values':31);
  32.     writeln;
  33.     write_text(0);
  34.     write_text(10);
  35.     write_text(100);
  36.     write_text(110);
  37.     write_text(1000);
  38.     write_text(1010);
  39.     write_text(1110);
  40.     write_text(10000);
  41.     write_text(10010);
  42.     writeln('Faulty value:');
  43.     write_text(3);
  44.     write_text(-773);
  45.     write_text(-7730);
  46. end;
  47. (********************************)
  48. begin
  49.  
  50. {FUNCTION    datetext(newdt_long:longint;long:integer):string;}
  51. { returns a string of the dates to print, returns different date formats
  52.     dependent upon value of long and in the different languages set with
  53.     global variable "language" (default: German, of course, set in the
  54.     initialization part of the unit DATEBOX)}
  55. {    values of long:                                              8 ->        02.09.91
  56.                                                                     10 ->         02.09.1991
  57.     add 10 to eliminate leading zero's              18(20) ->        2.9.(19)91
  58.     add 100 to get 'Mon, (D)D.(M)M.(YY)YY' format
  59.     add 1000 to get 'Monday (D)D. September (YY)YY' format
  60.     add 10000 to get 'Monday (D)D. Sep. (YY)YY' format                                }
  61.     repeat
  62.           clrscr;
  63.         writeln('TEST DATETEXT: Enter date as a LONGINT (CCYYMMDD ie 19910331)');
  64.        writeln('No range tests! Just century may be omitted; no weekdays then!');
  65.         writeln;
  66.        readln(long_i);
  67.        i:=0;
  68.         ch:='?';
  69.         repeat
  70.           language:=i;
  71.             test_text(long_i);
  72.             if i<3 then begin
  73.               writeln;
  74.                 writeln('ESC to leave procedure, ENTER to continue');
  75.                   ch:=readkey;
  76.               clrscr;
  77.           end;
  78.           writeln;
  79.           inc(i);
  80.         until (ch=#27) or (i>3);
  81.         writeln;
  82.         if ch<>#27 then begin
  83.           writeln;
  84.             writeln('ESC to leave procedure, ENTER to continue');
  85.             ch:=readkey;
  86.         end;
  87.       until ch=#27;
  88.    ch:='?';
  89.    language:=language_set;
  90. end;
  91. (********************************)
  92. procedure testdt_from_stringdat;
  93. {PROCEDURE dt_from_stringdat(var s:string;var dt:datetime);}    {Rudolf Regez}
  94. { converts date-string into datetime-date}
  95. begin
  96.    language:=language_SET;
  97.     repeat
  98.           clrscr;
  99.         writeln('TEST DT_FROM_STRING: Enter date as a string ie March, 15th 1991');
  100.        writeln('Limit: try: "roman emperor Augustus, eating 1 apple, went to bed at 11.45pm!"');
  101.        writeln('or: "May I sell this 3 sets at $1500 each ?" (monthname is case and language');
  102.       writeln('sensitive, the strings above just work if language=English)');
  103.         writeln;
  104.        readln(buf);
  105.       dt_from_stringdat(buf,buf_dt);
  106.       if pos('?',buf)=0 then begin
  107.           write(datetext(buf_dt,10),' or  ');
  108.           write(datetext(buf_dt,1020));
  109.           buf_dt1:=buf_dt;
  110.           next_day(buf_dt);
  111.           writeln(';  next: ',datetext(buf_dt,10));
  112.             writeln(date_diff(sysdatetime,buf_dt1),' days from SYSTIME, which is ',
  113.                 datetext(sysdatetime,1020));
  114.       end
  115.       else begin
  116.             write(#7);
  117.          writeln(buf);
  118.       end;
  119.       writeln;
  120.         writeln('ESC to leave procedure, ENTER to continue');
  121.       ch:=readkey;
  122.       until ch=#27;
  123.    ch:='?';
  124. end;
  125. (********************************)
  126. procedure testread_date;
  127. begin
  128.    language:=language_SET;
  129.     repeat
  130.           clrscr;
  131.         writeln('TEST READ_DATE: Enter date as DD.MM.(CC)YY');
  132.        writeln('the separator set (now: "',separator,'") has a certain CR-function;');
  133.        writeln('try:  "2',separator,'2',separator,'" and CR or "2 CR 2 CR CR"!');
  134.        writeln('Just CR returns the system-date');
  135.         writeln;
  136.       buf:='';            {no default}
  137.       gotoxy(10,10);
  138.        read_date(buf,buf_dt,key);
  139.       if key<>escapekey then write('   ',datetext(buf_dt,1010));
  140.       writeln;
  141.       writeln;
  142.         writeln('ESC to leave procedure, ENTER to continue');
  143.       ch:=readkey;
  144.       until ch=#27;
  145.    ch:='?';
  146. end;
  147. (********************************)
  148. begin
  149. language_set:=language;
  150. repeat
  151.    clrscr;
  152.    gotoxy(20,10);
  153.    Writeln('.....some silly tests with dates...');
  154.    writeln;
  155.    gotoxy(20,12);
  156.    writeln('1  :  date output');
  157.    gotoxy(20,13);
  158.    writeln('2  :  analyse date string');
  159.    gotoxy(20,14);
  160.    writeln('3  :  date entry');
  161.    gotoxy(20,17);
  162.    write('enter # ,  ESC to leave:  ');
  163.    gotoxy(25,19);
  164.    write('8 to alter separator (now: "',separator,'")');
  165.    gotoxy(25,20);
  166.    write('9 to alter language (now: "',language_set,'")');
  167.    ch:=readkey;
  168.    case ch of
  169.    '1' :    test_datetext;
  170.     '2' : testdt_from_stringdat;
  171.    '3' : testread_date;
  172.    '8' : begin
  173.              writeln;
  174.             writeln('choose separator! ');
  175.             ch:=readkey;
  176.             separator:=ch;
  177.             end;
  178.    '9' : begin
  179.              writeln;
  180.             writeln('0: English, 1: German, 2: French, 3: Italian; enter #');
  181.             ch:=readkey;
  182.             if ch in ['0'..'3'] then language_set:=ord(ch)-48
  183.             else language_set:=0;
  184.             end;
  185.    #27 : halt;
  186.    else test_datetext;
  187.    end;
  188. until ch=#27;
  189. end.